home *** CD-ROM | disk | FTP | other *** search
/ Aminet 21 / Aminet 21 (1997)(GTI - Schatztruhe)[!][Oct 1997].iso / Aminet / dev / misc / p96pcq.lha / Picasso96PCQ / Examples / OpenScreen.bak < prev    next >
Encoding:
Text File  |  1997-07-18  |  5.3 KB  |  202 lines
  1.  
  2. PROGRAM OpenScreen;
  3.  
  4. {
  5.     PCQ-Version des Picasso96-Demoprogrammes
  6.  
  7.     in Pascal übersetzt von Andreas Neumann
  8. }
  9.  
  10. {$I "Include:exec/interrupts.i" }
  11. {$I "Include:exec/libraries.i" }
  12. {$I "Include:libraries/dos.i" }
  13. {$I "Include:graphics/graphics.i" }
  14. {$I "Include:graphics/pens.i" }
  15. {$I "Include:intuition/intuition.i" }
  16. {$I "Include:utils/random.i" }
  17. {$I "Include:p96/Picasso96.i" }
  18.  
  19. Const
  20.     gfxname :   String = "graphics.library";
  21.     ScreenTitle :   String  =   "Picasso96 API Test";
  22.     W1Title     :   String  =   "WritePixel";
  23.     W2Title     :   String  =   "FillRect";
  24.     Width   :   Integer =   640;
  25.     Height  :   Integer =   480;
  26.     Depth   :   Integer =   8;
  27.     Pens    :   Integer =   0;
  28.  
  29.     W1NW    :   NewWindow = (0,0,200,300,-1,-1,RAWKEY_f+CLOSEWINDOW_f,
  30.                              WINDOWDRAG+WINDOWDEPTH+WINDOWSIZING+GIMMEZEROZERO+ACTIVATE+SIMPLE_REFRESH+REPORTMOUSE_f+WINDOWCLOSE+RMBTRAP,
  31.                              NIL,NIL,W1Title,NIL,NIL,0,0,0,0,CUSTOMSCREEN_f);
  32.     W2NW    :   NewWindow = (0,0,200,300,-1,-1,RAWKEY_f+CLOSEWINDOW_f,
  33.                              WINDOWDRAG+WINDOWDEPTH+WINDOWSIZING+GIMMEZEROZERO+ACTIVATE+SIMPLE_REFRESH+REPORTMOUSE_f+WINDOWCLOSE+RMBTRAP,
  34.                              NIL,NIL,W2Title,NIL,NIL,0,0,0,0,CUSTOMSCREEN_f);
  35.  
  36. Var
  37.     i       :   Integer;
  38.     sc      :   ScreenPtr;
  39.     ptags   :   Array [0..32] Of TagItem;
  40.     w1,
  41.     w2      :   WindowPtr;
  42.     rp1,
  43.     rp2     :   RastPortPtr;
  44.     terminate   :   Boolean;
  45.     signals     :   Integer;
  46.     format      :   RGBFTYPE;
  47.     x1, y1,
  48.     x2, y2,
  49.     x3, y3      :   Short;
  50.     imsg        :   IntuiMessagePtr;
  51.     msg         :   MessagePtr;
  52.  
  53. BEGIN
  54.  GFXBase:=OpenLibrary (gfxname,0);
  55.  IF GFXBase<>Nil Then
  56.  Begin
  57.   P96Base:=OpenLibrary (P96NAME,0);
  58.   If P96Base<>Nil Then
  59.   Begin
  60.    ptags[0].ti_Tag:=P96SA_Width;
  61.    ptags[0].ti_Data:=Width;
  62.    ptags[1].ti_Tag:=P96SA_Height;
  63.    ptags[1].ti_Data:=Height;
  64.    ptags[2].ti_Tag:=P96SA_Depth;
  65.    ptags[2].ti_Data:=Depth;
  66.    ptags[3].ti_Tag:=P96SA_AutoScroll;
  67.    ptags[3].ti_Data:=Integer(TRUE);
  68.    ptags[4].ti_Tag:=P96SA_Pens;
  69.    ptags[4].ti_Data:=Pens;
  70.    ptags[5].ti_Tag:=P96SA_Title;
  71.    ptags[5].ti_Data:=Integer(ScreenTitle);
  72.    ptags[6].ti_Tag:=TAG_DONE;
  73.  
  74.    sc:=p96OpenScreenTagList (Adr(ptags));
  75.    If sc=Nil Then
  76.     Writeln ("Kann Screen nicht öffnen.")
  77.    Else
  78.    Begin
  79.     W1NW.Screen:=sc;
  80.     W1NW.LeftEdge:=((sc^.Width DIV 2)-200)+(sc^.Width DIV 2);
  81.     W1NW.TopEdge:=((sc^.Height-sc^.BarHeight-300) DIV 2);
  82.     W1NW.MinHeight:=sc^.BarHeight+1;
  83.     W1NW.MaxWidth:=sc^.Width;
  84.     W1NW.MaxHeight:=sc^.Height-sc^.BarHeight-1;
  85.     w1:=OpenWindow (Adr(W1NW));
  86.     If w1<>Nil Then
  87.     Begin
  88.      W2NW.Screen:=sc;
  89.      W2NW.LeftEdge:=((sc^.Width DIV 2)-200);
  90.      W2NW.TopEdge:=((sc^.Height-sc^.BarHeight-300) DIV 2);
  91.      W2NW.MinHeight:=sc^.BarHeight+1;
  92.      W2NW.MaxWidth:=sc^.Width;
  93.      W2NW.MaxHeight:=sc^.Height-sc^.BarHeight-1;
  94.  
  95.      w2:=OpenWindow (Adr(W2NW));
  96.      If w2<>Nil Then
  97.      Begin
  98.       rp1:=w1^.RPort;
  99.       rp2:=w2^.RPort;
  100.       terminate:=False;
  101.       signals:=((1 shl w1^.UserPort^.mp_SigBit) or (1 shl w2^.UserPort^.mp_SigBit));
  102.       format:=RGBFTYPE (p96GetBitMapAttr (sc^.SRastPort.BitMap, P96BMA_RGBFORMAT));
  103.  
  104.       SelfSeed;
  105.  
  106.       Repeat
  107.        x1:=RangeRandom (w2^.Width);
  108.        y1:=RangeRandom (w2^.Height);
  109.        x2:=RangeRandom (w2^.Width);
  110.        y2:=RangeRandom (w2^.Height);
  111.        If x2<x1 Then
  112.        Begin
  113.         x3:=x2;
  114.         x2:=x1;
  115.         x1:=x3;
  116.        End;
  117.        If y2<y1 Then
  118.        Begin
  119.         y3:=y2;
  120.         y2:=y1;
  121.         y1:=y3;
  122.        End;
  123.  
  124.        x3:=RangeRandom (w1^.Width);
  125.        y3:=RangeRandom (w1^.Height);
  126.  
  127.        If format=RGBFB_CLUT Then
  128.        Begin
  129.         SetAPen (rp2, RangeRandom (255));
  130.         RectFill (rp2,x1,y1,x2,y2);
  131.  
  132.         SetAPen (rp1, RangeRandom (255));
  133.         WritePixel (rp1,x3,y3);
  134.        End
  135.        Else
  136.        Begin
  137.         p96RectFill (rp2, x1, y1, x2, y2,(RangeRandom(255) shl 16)+(RangeRandom(255) shl 8)+(RangeRandom (255)));
  138.  
  139.  
  140.         p96WritePixel (rp1, x3, y3, ((RangeRandom(255)) shl 16)+((RangeRandom(255)) shl 8)+(RangeRandom(255)));
  141.        End;
  142.  
  143.        Repeat
  144.         imsg:=Address(GetMsg (w1^.UserPort));
  145.         If imsg<>Nil Then
  146.         Begin
  147.          If ((imsg^.Class=CLOSEWINDOW_f) Or ((imsg^.Class=RAWKEY_f) And ((imsg^.Code=$40) or (imsg^.Code=$45)))) Then
  148.           terminate:=True;
  149.          ReplyMsg (Address(imsg));
  150.         End;
  151.        Until imsg=Nil;
  152.        Repeat
  153.         imsg:=Address(GetMsg (w2^.UserPort));
  154.         If imsg<>Nil Then
  155.         Begin
  156.          If ((imsg^.Class=CLOSEWINDOW_f) Or ((imsg^.Class=RAWKEY_f) And ((imsg^.Code=$40) or (imsg^.Code=$45)))) Then
  157.           terminate:=True;
  158.          ReplyMsg (Address(imsg));
  159.         End;
  160.        Until imsg=Nil;
  161.  
  162.       Until terminate;
  163.  
  164.       Forbid;
  165.       Repeat
  166.        msg:=GetMsg (w1^.UserPort);
  167.        If msg<>Nil Then
  168.         ReplyMsg (msg);
  169.       Until msg=Nil;
  170.       Repeat
  171.        msg:=GetMsg (w2^.UserPort);
  172.        If msg<>Nil Then
  173.         ReplyMsg (msg);
  174.       Until msg=Nil;
  175.       Permit;
  176.  
  177.       CloseWindow (w2);
  178.      End
  179.      Else
  180.       Writeln ("Kann W2 nicht öffnen.");
  181.      CloseWindow (w1);
  182.     End
  183.     Else
  184.      Writeln ("Kann W1 nicht öffnen.");
  185.  
  186.     p96CloseScreen (sc);
  187.    End;
  188.  
  189.    CloseLibrary (GfxBase);
  190.    CloseLibrary (P96Base);
  191.   End
  192.   Else
  193.   Begin
  194.    CloseLibrary (GfxBase);
  195.    Writeln ("Kann P96-Library nicht öffnen.");
  196.   End;
  197.  End
  198.  Else
  199.   Writeln ("Kann Gfx-Library nicht öffnen.");
  200. END.
  201.  
  202.